home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Small IO Examples / CalcDialog.icl next >
Encoding:
Text File  |  1997-04-25  |  5.3 KB  |  152 lines  |  [TEXT/3PRM]
  1. module CalcDialog
  2.  
  3. /*    A simple desk calculator using a dialog for the calculator.
  4.     This application requires the 0.8 I/O library.
  5.     Run the program using the "No Console" option (Application options).
  6. */
  7.  
  8. import    StdEnv, deltaEventIO, deltaDialog, deltaFont, deltaPicture
  9.  
  10. ::    State
  11.     =    {    arg1    :: !String
  12.         ,    op        :: !Operation
  13.         ,    arg2    :: !String
  14.         }
  15. ::    *IO            :==    IOState *State
  16. ::    Operation    :==    Int -> Int -> Int 
  17.  
  18. Start :: *World -> *World
  19. Start world
  20. #    (events,world)    = OpenEvents world
  21.     initstate        = {arg1="0",op=K,arg2=""} 
  22.     (_,events)        = StartIO [DialogSystem [dialog], MenuSystem [menu]] initstate [] events
  23.     world            = CloseEvents events world
  24. =    world
  25. where
  26.     menu :: MenuDef *State IO
  27.     menu            = PullDownMenu 0 "File" Able
  28.                         [    MenuItem 0 "Open Calculator" (Key 'O') Able Open
  29.                         ,    MenuItem 0 "Quit"            (Key 'Q') Able Quit
  30.                         ]
  31.     where
  32.         Open :: *State IO -> (*State, IO)
  33.         Open state io = (state, OpenDialog dialog io)
  34.         
  35.         Quit :: *State IO -> (*State, IO)
  36.         Quit state io = (state, QuitIO io)
  37.     
  38.     dialog :: DialogDef *State IO
  39.     dialog            = CommandDialog calcId "Calculator" 
  40.                         [    DialogMargin (Pixel 4) (Pixel 4)
  41.                         ,    ItemSpace    (Pixel 4) (Pixel 4)
  42.                         ]    idEq
  43.                         [    DialogIconButton idNum Center NumDom (NumLook "0") Unable (\_ state io -> (state,io))
  44.                         ,    CalcButton id7            (YOffset idNum (Pixel 12))    "7"   font (NumBut 7)
  45.                         ,    CalcButton id8            (RightTo id7)                "8"   font (NumBut 8)
  46.                         ,    CalcButton id9            (RightTo id8)                "9"   font (NumBut 9)
  47.                         ,    CalcButton idC            (RightTo id9)                "C"   font Clear
  48.                         ,    CalcButton id4            Left                        "4"   font (NumBut 4)
  49.                         ,    CalcButton id5            (RightTo id4)                "5"   font (NumBut 5)
  50.                         ,    CalcButton id6            (RightTo id5)                "6"   font (NumBut 6)
  51.                         ,    CalcButton idMul        (RightTo id6)                "*"   font (DiOp (*))
  52.                         ,    CalcButton id1            Left                        "1"   font (NumBut 1)
  53.                         ,    CalcButton id2            (RightTo id1)                "2"   font (NumBut 2)
  54.                         ,    CalcButton id3            (RightTo id2)                "3"   font (NumBut 3)
  55.                         ,    CalcButton idMin        (RightTo id3)                "-"   font (DiOp (-))
  56.                         ,    CalcButton id0            Left                        "0"   font (NumBut 0)
  57.                         ,    CalcButton idPlusMin    (RightTo id0)                "+/-" font PlusMin
  58.                         ,    CalcButton idEq            (RightTo idPlusMin)            "="   font Becomes
  59.                         ,    CalcButton idPlus        (RightTo idEq)                "+"   font (DiOp (+))
  60.                         ]
  61.     where
  62.         calcId    = 1
  63.         idNum    = 11
  64.         id7        = 7;        id8            = 8;        id9        = 9;    idC        = 12
  65.         id4        = 4;        id5            = 5;        id6        = 6;    idMul    = 13
  66.         id1        = 1;        id2            = 2;        id3        = 3;    idMin    = 18
  67.         id0        = 10;        idPlusMin    = 15;        idEq    = 14;    idPlus    = 19
  68.         
  69.         (_,font)= SelectFont "Geneva" [] 9
  70.         
  71.         CalcButton :: DialogItemId ItemPos ItemTitle Font (ButtonFunction *State IO) -> DialogItem *State IO
  72.         CalcButton id pos title font bfunc
  73.         =    DialogIconButton id pos buttonDomain look Able bfunc
  74.         where
  75.             buttonWidth    = 28
  76.             buttonHeight= 16
  77.             buttonDomain= ((0,0),(buttonWidth,buttonHeight))
  78.             
  79.             look :: SelectState -> [DrawFunction]
  80.             look _
  81.             =    [    SetFont            font
  82.                 ,    FillRectangle    shadowrect
  83.                 ,    SetPenColour    (RGB 0.5 0.5 0.5)
  84.                 ,    FillRectangle    buttonrect
  85.                 ,    SetPenColour    BlackColour
  86.                 ,    DrawRectangle    buttonrect
  87.                 ,    MovePenTo        ((buttonWidth-FontStringWidth title font)/2-1,11)
  88.                 ,    SetPenMode        OrMode
  89.                 ,    DrawString        title
  90.                 ]
  91.             where
  92.                 shadowrect    = ((2,2),(buttonWidth,buttonHeight))
  93.                 buttonrect    = ((0,0),(buttonWidth-2,buttonHeight-2))
  94.         
  95.         NumBut :: Int DialogInfo *State IO -> (*State, IO)        // The button function for the 0,1,2...9 buttons
  96.         NumBut num dialog state=:{arg1, arg2} io
  97.         |    arg2==""    = ({state & arg1=num1}, ChangeNumber num1 io)
  98.                         with
  99.                             num1 = addDigit arg1 num
  100.         |    otherwise    = ({state & arg2=num2}, ChangeNumber num2 io)
  101.                         with
  102.                             num2 = addDigit arg2 num
  103.         where
  104.             addDigit :: !String !Int -> String
  105.             addDigit arg nr
  106.             |    size arg>=12    = arg
  107.             |    arg=="0"        = toString nr
  108.             |    otherwise        = arg+++toString nr
  109.         
  110.         Clear :: DialogInfo *State IO -> (*State, IO)            // The button function for the Clear button
  111.         Clear _ _ io = ({arg1="0",op=K,arg2=""}, ChangeNumber "0" io)
  112.         
  113.         DiOp :: Operation DialogInfo *State IO -> (*State, IO)    // The button function for the '*','-', and '+' button
  114.         DiOp operator dialog state=:{arg2} io
  115.         |    arg2==""    = ({state & op=operator,arg2="0"}, io)
  116.         |    otherwise    = (state, Beep io)
  117.         
  118.         PlusMin :: DialogInfo *State IO -> (*State, IO)            // The button function for the '+/-' button
  119.         PlusMin dialog state=:{arg1, arg2} io
  120.         |    arg2==""    = ({state & arg1=neg1}, ChangeNumber neg1 io)
  121.                         with
  122.                             neg1 = ~arg1
  123.         |    otherwise    = ({state & arg2=neg2}, ChangeNumber neg2 io)
  124.                         with
  125.                             neg2 = ~arg2
  126.         
  127.         Becomes :: DialogInfo *State IO -> (*State, IO)            // The button function for the '=' button
  128.         Becomes dialog {arg1,op,arg2} io
  129.         =    ({arg1=result,op=K,arg2=""}, ChangeNumber result io)
  130.         where
  131.             result    = toString (op (toInt arg1) (toInt arg2))
  132.         
  133.         NumDom    = ((0,0),(105,17))
  134.         
  135.         NumLook :: String SelectState -> [DrawFunction]            // The look of the calculator display
  136.         NumLook num _
  137.         =    [    MovePenTo        (4,13)
  138.             ,    SetPenColour    BlackColour
  139.             ,    SetPenMode        OrMode
  140.             ,    DrawString        num
  141.             ,    SetPenNormal
  142.             ,    DrawRectangle    NumDom
  143.             ]
  144.         
  145.         ChangeNumber :: String IO -> IO                            // Change the number in the calculator display
  146.         ChangeNumber num io = ChangeDialog calcId [ChangeIconLook idNum (NumLook num)] io
  147.  
  148. instance ~ {#Char}
  149. where
  150.     (~) :: !{#Char} -> {#Char}
  151.     (~) numstring = toString (~(toInt numstring))
  152.